COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL Interpreter
C00005 00003	GETARG:
C00009 00004	Flow-of-control routines
C00014 00005	Routines which return scalars
C00019 00006	Routines which return vectors
C00025 00007	routines which return a trans
C00027 ENDMK
C⊗;
.SBTTL Interpreter

;Register uses in the interpreter:
;	R3	interpreter stack pointer
;	R4	points to interpreter status block

;Interpreter status block
	II == 0
	XX SR0	;Saved R0 (across waits)
	XX SR1	;Saved R1 (across waits)
	XX SR2	;Saved R2 (across waits)
	XX SR3	;Saved R3 (across waits)
	XX SR4	;Saved R4 (across waits)
	XX SRF	;Saved RF (across waits)
	XX SSP	;Saved SP (across waits)
	XX SPC	;Saved PC (across waits)
	XX IPC	;Interpreter program counter
	XX ICR	;Interpreter cross-reference (to HAL code)
	XX BASE	;Stack base for this lexical level, dynamic level
	XX LEV	;Lexical level of current execution
	ISBS = II/2	;Size (in words) of interpreter status block

;Data area for each interpreter-level block
	II == 0
	XX SLINK	;Static link to next (outer, lower numbered) block

;Interpreter itself
INTERP:	MOV @IPC(R4),R0	;R0 ← next instruction
	BLT INTER1	;Instruction out of range
	CMP R0,INSEND	;Is instruction too large?
	BHI INTER1	;Yes.
	ADD #2,IPC(R4)	;Bump IPC
	JSR PC,@INTOPS(R0)	;Call the appropriate routine
	BVC INTERP	;If all went well, do another instruction
	BR  INTERR(R0)	;Else go to the right error routine.

INTER1:	HALERR INTMS1
INTMS1:	ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/

INTERR: JMP RUG
	JMP RUG
	JMP RUG		;Temporarily a cop-out.

INTOPS:	GTVAL		;Push value of arg.
	CHNGE		;Pop value into arg.
	SAS		;S+S:  Add top two elts, pop, pop, push answer
	SMS		;S*S:  Mul top two elts, pop, pop, push answer
	SDS		;S/S:  Div top two elts, pop, pop, push answer
	NS		;-S:   Negate top elt, pop, push answer
	VDV		;S ← vector dot vector
	PDV		;Scalar ← plane dot vector
	NRMV		;Scalar ← norm of vector
	SMV		;Vector ← scalar * vector
	UNITV		;Vector ← vector / its norm
	CROSV		;Vector ← vector cross vector
	TMV		;Vector ← trans * vector

	INSEND = .-INTOPS;Marks the end of the instructions
GETARG:
;This routine returns in R0 a pointer to the location in the current block
;  area pointing to the variable which is named in R0 in this format:
;  The low order byte is the lexical level, and the high byte is the
;  offset.
	MOV R2,-(SP)	;Save R2
	MOVB R0,R1	;R1 ← Lexical level
	CLRB R0		;
	SWAB R0		;R0 ← Offset
	MOV BASE(R4),R2	;R2 ← LOC[base of current data area]
	SUB LEV(R4),R1	;R1 ← Difference in levels: desired-got
	BEQ GTRG1	;Diff=0; can use R2 as pointer at right base.
GTRG2:	MOV SLINK(R2),R2;No, must go up a level.  R2 ← LOC[base of upper area]
	INC R1		;R1 ← New difference in levels
	BNE GTRG2	;If not yet good, then move up another level
GTRG1:	ADD R2,R0	;R0 ← base + offset = location of desired pointer
	MOV (SP)+,R2	;Restore R2.
	RTS PC		;Done.

GETSCA:	;Gets place for a scalar result, and places a pointer on
	;the interpreter stack.  Location is returned in R0.  
	;Simple procedure.
;	MOV #2,R0	;Number of words needed
;	JSR PC,GETSMA	;R0 ← LOC[new block]
	MOV #RES,R0	;Temporary kludge.  Delete this line in final runs.
	MOV R0,-(R3)	;Push new value cell pointer on interpreter stack.
	RTS PC		;Done

GETVEC:	;Gets place for a vector result, and places a pointer on
	;the interpreter stack.  Location is returned in R0.  
	;Simple procedure.
;	MOV #10,R0	;Number of words needed
;	JSR PC,GETSMA	;R0 ← LOC[new block]
	MOV #RES,R0	;Temporary kludge.  Delete this line in final runs.
	MOV R0,-(R3)	;Push new value cell pointer on interpreter stack.
	RTS PC		;Done

GTVAL:	MOV @IPC(R4),R0	;Pick up level-offset name of argument
	ADD #2,IPC(R4)	;Bump IPC
	JSR PC,GETARG	;R0 ← LOC[LOC[desired graph node]]
	MOV (R0),R0	;R0 ← LOC[desired graph node]
	CALL GETVAL,<R0>;R0 ← value
	MOV R0,-(R3)	;Push value on interpreter stack.
	RTS PC		;Done

CHNGE:	MOV @IPC(R4),R0	;Pick up level-offset name of argument
	ADD #2,IPC(R4)	;Bump IPC
	JSR PC,GETARG	;R0 ← LOC[LOC[Desired graph node]]
	MOV (R0),R0	;R0 ← LOC[Desired graph node]
	CALL CHANGE,<R0,(R3)>
	TST (R3)+	;Pop stack
	RTS PC		;Done

;Flow-of-control routines

;Procedure call.  Arguments: 
;	Destination.
;	List of variables which are to be inserted in appropriate 
;	  locations in the local storage of procedure.  These are
;	  in the format variable (ie level-offset pair), new offset
;	  (right justified in the second word).
;	  There is a zero word to finish these.
;The destination address contains these words:
	II == 0
	XX FSLGTH	;Number of words to get from free storage 
			;for local variable pointers
	XX PLEV		;Lexical level of procedure
	DSLGTH == II	;Number of words before code starts
;Value parameters are copied first into local temps (which have been
;	arranged by the compiler), and then the temps are passed by
;	reference.  Eventual problem:  to know which variables to
;	really kill as the procedure is exited.

PROC:	MOV R2,-(SP)	;Save R2
	MOV @IPC(R4),R2	;R2 ← LOC[destination]
	ADD #2,IPC(R4)	;Bump IPC
	MOV FSLGTH(R2),R0 ;R0 ← Number of words to get.
	JSR PC,GTFREE	;R0 ← LOC[block with that number of words]

      ;initialize pointer to lexical level:
	MOV PLEV(R2),R1	;R1 ← Lexical level of procedure
	MOV BASE(R4),R2	;R2 ← LOC[base of current data area]
	SUB LEV(R4),R1	;R1 ← Difference in levels: desired-got
	BEQ PRC1	;Diff=0; can use R2 as pointer at right base.
PRC2:	MOV SLINK(R2),R2;No, must go up a level.  R2 ← LOC[base of upper area]
	INC R1		;R1 ← New difference in levels
	BNE PRC2	;If not yet good, then move up another level
PRC1:	MOV R2,SLINK(R0);SLINK[new block] ← correct base

      ;Put copies of local variables in new area
	MOV R0,-(SP)	;Stack LOC[new block]
	MOV @IPC(R4),R0	;R0 ← level-offset pair for an argument
	BEQ PRC3	;If there are no more, go to next phase
PRC4:	ADD #2,IPC(R4)	;Else bump IPC
	JSR PC,GETARG	;R0 ← LOC[LOC[graph node]]
	MOV @IPC(R4),R1	;R1 ← offset in new block
	ADD #2,IPC(R4)	;Bump IPC
	ADD (SP),R1	;R1 ← LOC[place in new block to put pointer]
	MOV (R0),(R1)	;new block has a pointer to LOC[argument graph node]
	MOV @IPC(R4),R0	;R0 ← level-offset pair for an argument
	BNE PRC4	;If there are more, go back and treat them
PRC3:	ADD #2,IPC(R4)	;Bump IPC one last time

      ;Save the old context on the interpreter stack
	MOV LEV(R4),-(R3) ;Push the old level
	MOV BASE(R4),-(R3);Push the old display base location
	MOV IPC(R4),-(R3) ;Push the return address

      ;Set up the new context for procedure
	MOV PLEV(R2),LEV(R4) ;New lexical level
	MOV (SP)+,BASE(R4)   ;New block base
	ADD DSLGTH,R2	;R2 ← Place where execution should begin
	MOV R2,IPC(R4)	;New program counter
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done


RETURN:
;Returns from a procedure call to calling program.
;Since variables are passed by reference, it is not necessary
;to do any copying of values. All that is needed is to restore
;the context of the caller and to discard the display.
	MOV (R3)+,LEV(R4) ;Restore the old lexical level
	MOV BASE(R4),R0	;R0 ← LOC[old display]
	JSR PC,RLFREE	;Release storage of old display
	MOV (R3)+,BASE(R4);Restore the display base
	MOV (R3)+,IPC(R4) ;Restore the IPC
	RTS PC		;Done
;Routines which return scalars
;All timings are averages of 1000 runs.  They take into account
;the cost of the RTS but not the JSR.  It is assumed that GETSCA
;and GETVEC take no time.

;30 microseconds
SAS:	;Scalar ← Scalar + Scalar
	LDF @(R3)+,AC0	;AC0 ← arg 2
	ADDF @(R3)+,AC0	;AC0 ← arg2 + arg1
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	RTS PC		;Done

;30 microseconds
SMS:	;Scalar ← scalar * scalar
	LDF @(R3)+,AC0	;AC0 ← arg 2
	MULF @(R3)+,AC0	;AC0 ← arg2 * arg1
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	RTS PC		;Done

;33 microseconds
SDS:	;Scalar ← Scalar / Scalar
	LDF @(R3)+,AC1	;AC1 ← arg 2
	LDF @(R3)+,AC0	;AC0 ← arg 1
	DIVF AC1,AC0	;AC0 ← arg1 / arg2
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	RTS PC		;Done

;26 microseconds
NS:	;Scalar ← -Scalar
	LDF @(R3)+,AC0	;AC0 ← arg
	NEGF AC0	;AC0 ← -arg
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	RTS PC		;Done

;96 -- 116 microseconds
VDV:	;Scalar ← Vector dot Vector
	;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
	MOV R2,-(SP)	;Save R2.
	MOV (R3)+,R1	;R1 ← LOC[arg 2]
	MOV (R3)+,R0	;R0 ← LOC[arg 1]
	CLRF AC0	;AC0 ← 0.  Running total
	MOV #3,R2	;R2 ← 3:  Length of vector
VDV1:	LDF (R0)+,AC1	;Form sum of products of first 3 terms
	MULF (R1)+,AC1	;
	ADDF AC1,AC0	;
	SOB R2,VDV1	;Loop until all 3 fields done.
	DIVF (R0),AC0	;Divide by W1
	DIVF (R1),AC0	;Divide by W2.  AC0 now has answer.
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;103 -- 116 microseconds
PDV:	;Scalar ← Plane dot Vector
	;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
	MOV R2,-(SP)	;Save R2.
	MOV (R3)+,R1	;R1 ← LOC[arg 2]
	MOV (R3)+,R0	;R0 ← LOC[arg 1]
	CLRF AC0	;AC0 ← 0.  Running total
	MOV #4,R2	;R2 ← 4:  Length of vector and weight
PDV1:	LDF (R0)+,AC1	;Form sum of products of all 4 terms
	MULF (R1)+,AC1	;
	ADDF AC1,AC0	;
	SOB R2,PDV1	;Loop until all 3 fields done.
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store result
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;199 -- 207 microseconds
NRMV:	;Scalar ← Norm (vector)
	;S ← SQRT(XX + YY+ ZZ) / W
	MOV (R3)+,R1	;R1 ← LOC[arg]
	LDF (R1)+,AC0	;AC0 ← X
	MULF AC0,AC0	;AC0 ← XX
	LDF (R1)+,AC1	;AC1 ← Y
	MULF AC1,AC1	;AC1 ← YY
	ADDF AC1,AC0	;AC0 ← XX + YY
	LDF (R1)+,AC1	;AC1 ← Z
	MULF AC1,AC1	;AC1 ← ZZ
	ADDF AC1,AC0	;AC0 ← XX + YY + ZZ
	MOV R1,-(SP)	;Push LOC[W] onto system stack, to save across SQRTF
	JSR PC,SQRTF	;AC0 ← SQRT(XX + YY + ZZ)
	DIVF @(SP)+,AC0	;AC0 ← AC0 / W
	JSR PC,GETSCA	;R0 ← -(R3) ← LOC[new scalar block]
	STF AC0,(R0)	;Store answer
	RTS PC		;Done
;Routines which return vectors

;83 -- 91 microseconds
SMV:	;Vector ← Scalar * Vector
	;X ← S*X,  Y ← S*Y,  Z ← S*Z,  W ← W
	MOV R2,-(SP)	;Save R2
	MOV (R3)+,R1	;R1 ← LOC[vector]
	LDF @(R3)+,AC0	;AC0 ← scalar;
	JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	MOV #3,R2	;R2 ← 3:  How many fields to handle
SMV1:	LDF (R1)+,AC1	;AC1 ← next field of vector
	MULF AC0,AC1	;AC1 ← product
	STF AC1,(R0)+	;Store result
	SOB R2,SMV1	;Loop until all 3 fields done.
	MOV (R1)+,(R0)+	;Transfer W
	MOV (R1)+,(R0)+	;  which is 2 words long.
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;281 -- 286 microseconds
UNITV:	;Vector ← V / Norm(V)
	;S ← SQRT(XX + YY+ ZZ) / W
	MOV R2,-(SP)	;Save R2
	MOV (R3),R1	;R1 ← LOC[arg]
	LDF (R1)+,AC0	;AC0 ← X
	MULF AC0,AC0	;AC0 ← XX
	LDF (R1)+,AC1	;AC1 ← Y
	MULF AC1,AC1	;AC1 ← YY
	ADDF AC1,AC0	;AC0 ← XX + YY
	LDF (R1)+,AC1	;AC1 ← Z
	MULF AC1,AC1	;AC1 ← ZZ
	ADDF AC1,AC0	;AC0 ← XX + YY + ZZ
	MOV R1,-(SP)	;Save R1 across SQRTF
	JSR PC,SQRTF	;AC0 ← SQRT(XX + YY + ZZ)
	MOV (SP)+,R1	;Restore R1
	DIVF (R1),AC0	;AC0 ← Norm = SQRT / W
	MOV (R3)+,R1	;R1 ← LOC[arg]
	JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	MOV #3,R2	;R2 ← count of fields
UNITV1:	LDF (R1)+,AC1	;AC1 ← field of vector
	DIVF AC0,AC1	;divide by norm
	STF AC1,(R0)+	;Store result
	SOB R2,UNITV1	;Loop until done
	MOV (R1)+,(R0)+	;Copy W.
	MOV (R1),(R0)	;   (two words long)
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;172 -- 184 microseconds
CROSV:	;Vector ← Vector cross Vector
	;X ← Y1Z2 - Y2Z1
	;Y ← X2Z1 - X1Z2
	;Z ← X1Y2 - X2Y1
	;W ← W1W2
	;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
	MOV R2,-(SP)	;Save R2
	MOV (R3),R2	;R2 ← LOC[arg 2]
	JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector block]
	MOV 4(R3),R1	;R1 ← LOC[arg 1].  Must not pop R3 stack yet!
	LDF 14(R1),AC0	;AC0 ← W1
	MULF 14(R2),AC0	;AC0 ← W1W2
	STF AC0,14(R0)	;Store AC0 → W
	LDF 4(R1),AC0	;AC0 ← Y1
	LDF (R2),AC1	;AC1 ← X2
	LDF 4(R2),AC2	;AC2 ← Y2
	LDF (R1),AC3	;AC3 ← X1
	STF AC3,AC4	;AC4 ← X1
	STF AC0,AC5	;AC5 ← Y1
	MULF AC2,AC3	;AC3 ← X1Y2
	MULF AC1,AC0	;AC0 ← X2Y1
	SUBF AC0,AC3	;AC3 ← X1Y2 - X2Y1
	STF AC3,10(R0)	;Z ← AC3
	LDF 10(R2),AC0	;AC0 ← Z2
	LDF 10(R1),AC3	;AC3 ← Z1
	MULF AC4,AC0	;AC0 ← X1Z2
	MULF AC3,AC1	;AC1 ← X2Z1
	SUBF AC0,AC1	;AC1 ← X2Z1 - X1Z2
	STF AC1,4(R0)	;Y ← AC1
	LDF 10(R2),AC0	;AC0 ← Z2
	MULF AC5,AC0	;AC0 ← Y1Z2
	MULF AC2,AC3	;AC3 ← Y2Z1
	SUBF AC3,AC0	;AC0 ← Y1Z2 - Y2Z1
	STF AC0,(R0)	;X ← AC0
	MOV (R3)+,2(R3)	;Put result cell where first argument was
	TST (R3)+	;Put stack pointer in right place
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;283 -- 324 microseconds
TMV:	;Vector ← Trans * Vector
	MOV R2,-(SP)	;Save R2
	MOV (R3),R2	;R2 ← LOC[vector]
	MOV 2(R3),R0	;R0 ← LOC[trans]
	CLRF AC1	;X ← 0
	CLRF AC2	;Y ← 0
	CLRF AC3	;Z ← 0
	MOV #4,R1	;R1 ← How many columns left to go
TMV1:	LDF (R2)+,AC0	;AC0 ← field of vector
	STF AC0,AC5	;AC5 ← copy of AC0
	MULF (R0)+,AC0	;
	ADDF AC0,AC1	;Add partial result to X
	LDF AC5,AC0	;Restore AC0
	MULF (R0)+,AC0	;
	ADDF AC0,AC2	;Add partial result to Y
	LDF AC5,AC0	;Restore AC0
	MULF (R0)+,AC0	;
	ADDF AC0,AC3	;Add partial result to Z.
	TST (R0)+	;Skip bottom row
	TST (R0)+	;  (2 words long)
	SOB R1,TMV1	;Go back to do all 4 columns.
	JSR PC,GETVEC	;R0 ← -(R3) ← LOC[new vector]
	STF AC1,(R0)+	;Store X
	STF AC2,(R0)+	;Store Y
	STF AC3,(R0)+	;Store Z
	MOV -4(R2),(R0)+;Copy W from the vector
	MOV -2(R2),(R0)	;  (2 words long)
	MOV (R3)+,2(R3)	;Put result cell where first argument was
	TST (R3)+	;Put stack pointer in right place
	MOV (SP)+,R2	;Restore R2
	RTS PC		;Done

;routines which return a trans